home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / comm / yep16.zip / YEP16SRC.ZIP / YEP165.PAS < prev   
Pascal/Delphi Source File  |  1997-04-09  |  58KB  |  1,553 lines
  1. Program Yep;
  2. {$M 32762}
  3. {&Delphi-}
  4. {$R-}
  5. {$DEFINE ZEBUG}
  6.  
  7. Uses Dos, tm_dos, tm_str, strings, tm_strgs, crt, tm_exit, pomu, dtu, tm_Date;
  8.  
  9. Type
  10.     MsgHeaders = (hd_ng, hd_to, hd_date, hd_subj, hd_xg, hd_refs, hd_from, hd_repto, hd_sender, hd_cc, hd_bcc, hd_nil);
  11.  
  12. Const
  13.      MaxStr  = 50000;
  14.      MaxPath = 80;
  15.      MaxLine = 80;
  16.      cmtChar = ';';
  17.      MaxHead = 50;
  18.      MaxSubst= 100;
  19.      MaxXUrl = 20;
  20.      MaxPrem = 25;
  21.      MaxBlocks = 15;
  22.      nntp_strlen = 512; {defined in uqwk and rfc}
  23.  
  24.      StartLineMode : byte = 0;   {0=line 1, 1=past header, 2=past quote}
  25.      CursorAdjust  : integer = 0;
  26.  
  27.      processfiles  : string[128] = '*.snd\*.msg\message$.r*\*.pop'; {pattern of filenames to process}
  28.  
  29.      HeadNum  : byte = 0;
  30.      PremNum  : byte = 0;
  31.      StartLine: byte = 1;
  32.      SubNum   : byte = 0;
  33.      BlockNum : byte = 0;
  34.      RepTags = (4)-1;
  35.      RepTag  : array[0..RepTags] of Pchar = (
  36.                                     '{RNDN:',
  37.                                     '{YPDEC:',
  38.                                     '{DATE:',
  39.                                     '{RNDC:'
  40.                                     );
  41.      YepTags = (23)-1;
  42.      YepTag  : array[0..YepTags] of Pchar = (
  43.                                     '{$c■x:',
  44.                                     '{RNDL:',
  45.                                     '{RNDF:',
  46.                                     '{IMPF:',
  47.                                     '{EXEC:',
  48.                                     '{IFFLAG:',
  49.                                     '{IMPL:',
  50.                                     '{IFTO:',
  51.                                     '{IFSUBJ:',
  52.                                     '{IFDATE:',
  53.                                     '{IFNG:',
  54.                                     '{SETFLAG:',
  55.                                     '{IMPLS:',
  56.                                     '{IMPLR:',
  57.                                     '{UUEN:',
  58.                                     '{IFXN:',
  59.                                     '{IFCC:',
  60.                                     '{POM:',
  61.                                     '{IFBCC:',
  62.                                     '{EXPD:',
  63.                                     '{HEADER:',
  64.                                     '{IFRT:',
  65.                                     '{IFSD:');
  66.  
  67. (*     SpecialTags = 1;                               { 1        2        3        4   }
  68.      SpecialTag  : array[1..SpecialTags] of Pchar = ('{moond}');*)
  69.  
  70.      XUrlNum  : byte = 0;
  71.      YepUrls = 4;
  72.      YepUrl  : array[1..YepUrls] of Pchar = ('HTTP://','FTP://','TELNET://','GOPHER://');
  73.  
  74.      BlockTags = 5;
  75.      BlockTag : array [1..BlockTags, 1..2] of pchar = (('[HEADE', '[END HE'),
  76.                                                        ('[SUBST', '[END SU'),
  77.                                                        ('[URL E', '[END UR'),
  78.                                                        ('[PRE M', '[END PR'),
  79.                                                        ('[BLOCK', '[END BL'));
  80.      CfgTags = 12;
  81.      CfgTag  : array [1..CfgTags] of pchar = ('EDITOR', 'CLEANHE', 'ROOTSIG',
  82.                      'PGPPAS','SHOWDOT','CURSORA','URLLOG','EMACSH','PREMESS',
  83.                      'QUOTEC','RIGHTM','PROCES');
  84.  
  85.      RightMargin : byte = 0;
  86.      QuoteChar : char = '>';
  87.      EmacsHeaderLine : pchar = nil;
  88.      BlockEnd : pchar = '[TheEnd]';
  89.  
  90.      fnEdit  : string[maxPath] = '';
  91.      fnTmp   : string[maxPath] = '';
  92.      fnUrlLog: string[maxPath] = '';
  93.      Fnpgp   : string[maxPath+30] = '';
  94.      fnCfg   : string[maxPath] = 'yep.cfg';
  95.      EdCmdLn : string = '';
  96.      RootSig : string[maxPath] = '';
  97.      ShowDots: boolean = True;
  98.      PgpPassword : pchar = nil;
  99.      pgpPassStr : pchar = 'PGPPASS=';
  100.  
  101.      GLOBALFLAG : boolean = FALSE;
  102.  
  103.      TogSubst: boolean = true;
  104.      TogAutoDePgp : boolean = false;
  105.      CleanHeader : boolean = False;
  106.      PostPrem : boolean = False;
  107.  
  108.      LastHeader : MsgHeaders = hd_nil;
  109.      FstHdr = hd_ng;
  110.      LstHdr = hd_Bcc;
  111.      MsgHdr : array[fsthdr..lsthdr,1..2] of pchar = (
  112.                                         {1} ('Newsgroups:',nil),
  113.                                         {2} ('To:',nil),
  114.                                         {3} ('Date:',nil),
  115.                                         {4} ('Subject:',nil),
  116.                                         {5} ('X-NewsGroups:',nil),
  117.                                         {6} ('References:',nil),
  118.                                         {7} ('From:',nil),
  119.                                         {8} ('Reply-To:',nil),
  120.                                         {9} ('Sender:',nil),
  121.                                        {10} ('Cc:',nil),
  122.                                        {11} ('Bcc:',nil)
  123.                                         );
  124.  
  125.  
  126.      y_pac = 'Press any key';
  127.  
  128.      tmpNamePrefix : boolean = false; { prefix temp file instead of change extention? }
  129.      tmpPrefix = 'Y!';
  130.      tmpExt = 'Yep';
  131.  
  132. (*
  133. {1}  Hd_NewsGroups : Pchar = nil;
  134. {2}  Hd_To : Pchar = nil;
  135. {3}  Hd_Date : Pchar = nil;
  136. {4}  Hd_Subject : Pchar = nil;
  137. {5}  Hd_x_group : Pchar = nil;
  138. {6}  Hd_Refs : Pchar = nil;
  139.  
  140.      str_NewsGroups : Pchar = 'Newsgroups:';
  141.      str_X_Group : Pchar = 'X-Newsgroups:';
  142.      str_To : Pchar = 'To:';
  143.      str_Date : Pchar = 'Date:';
  144.      str_Subject : Pchar = 'Subject:';
  145.      str_Refs : Pchar = 'References:';
  146. *)
  147.  
  148. type
  149.      tHeadAdd = array[1..maxHead] of Pchar;
  150.      tYepTarg = array[1..maxSubst] of Pchar;
  151.      tYepSub  = array[1..maxSubst] of Pchar;
  152.      tXUrlList= array[1..maxXUrl] of Pchar;
  153.      tPreM    = array[1..maxPrem] of Pchar;
  154.      tBlkTag  = array[1..maxBlocks] of Pchar;
  155.      tBlkCmd  = array[1..maxBlocks] of Pchar;
  156.      tBlkclose= array[1..maxBlocks] of char;
  157.  
  158.      sarray = array[0..25] of char;
  159.  
  160. Var
  161. {   f : text;
  162.    fout: text;
  163.    faux: text;}
  164.    fbuf : array[1..6144] of byte;
  165.  
  166.    HeadAdd : theadadd;
  167.    YepTarg : tyeptarg;
  168.    YepSub  : tyepsub;
  169.    XUrlList: txurllist;
  170.    Prem    : tPrem;
  171.    BlkTag  : tBlkTag;
  172.    BlkCmd  : tBlkCmd;
  173.    Blkclose: tBlkClose;
  174.    UrlCap  : pchar;
  175.  
  176.    st   : array[0..MaxStr] of char;
  177.    hr   : MsgHeaders;
  178.  
  179. (***********************************************************************)
  180. (***********************************************************************)
  181. Procedure WriteConfigFileValues;
  182. var x : byte;
  183. begin
  184.      writeln(EdCmdLn);
  185.      Writeln('cleanheader=',CleanHeader);
  186.      Writeln('startlinemode=',StartLineMode);
  187.      Writeln('showdots=',StartLineMode);
  188.      Writeln('rightMargin=',RightMargin);
  189.      Writeln('quotechar=',QuoteChar);
  190.      if HeadNum>0 then begin
  191.         writeln('-----------headers-------------');
  192.         for x:=1 to HeadNum do Writeln(HeadAdd[x]);
  193.      end;
  194.      if SubNum>0 then begin
  195.         writeln('--- ------substitutes----------');
  196.         for x:=1 to SubNum do Writeln(YepTarg[x],' <> ',YepSub[x]);
  197.      end;
  198.      if PremNum>0 then begin
  199.         writeln('---=------pre message----------');
  200.         for x:=1 to PremNum do Writeln(Prem[x]);
  201.      end;
  202.      if BlockNum>0 then begin
  203.         writeln('---+------Block Defs----------');
  204.         for x:=1 to BlockNum do Writeln(blkTag[x],blkclose[x],'  ',blkCmd[x]);
  205.      end;
  206.      if XurlNum>0 then begin
  207.         writeln('----- ----Url Excludes----------');
  208.         for x:=1 to XurlNum do Writeln(XurlList[x]);
  209.         if fnUrlLog[0]<>#0 then writeln('Enabled: ',fnUrlLog) else writeln('DISABLED.');
  210.      end;
  211. end;
  212.  
  213. Procedure WriteMessageData;
  214. begin
  215.      writeln;
  216.      for hr := fstHdr to lsthdr do if MsgHdr[hr,2]<>nil then writeln(MsgHdr[hr,1],MsgHdr[hr,2]);
  217.      delay(750);
  218.  
  219. {     writeln(MsgHdr[hd_to,1],MsgHdr[hd_to,2]);
  220.      writeln(MsgHdr[hd_Subj,1],MsgHdr[hd_Subj,2]);
  221.      writeln(MsgHdr[hd_date,1],MsgHdr[hd_date,2]);
  222.      writeln(MsgHdr[hd_ng,1],MsgHdr[hd_ng,2]);}
  223. end;
  224.  
  225.  
  226. (***********************************************************************)
  227. (***********************************************************************)
  228. function b_or_e(s,c:string) : boolean; {simplified wildcard... begin or end with *}
  229. begin
  230.      b_or_e :=false;
  231.      if c[1]='*' then begin
  232.         if length(c)=1 then b_or_e:=true
  233.         else
  234.         b_or_e:=(upstr(copy(c,2,255))=upstr(copy(s,length(s)-(length(c)-2),length(c)-1)));
  235.      end
  236.      else if c[length(c)]='*' then begin
  237.         b_or_e:=(upstr(copy(c,1,length(c)-1))=upstr(copy(s,1,length(c)-1)));
  238.      end
  239.      else begin
  240.         b_or_e:=(upstr(c)=upstr(s));
  241.      end;
  242. end;
  243. {----------------------------------------------------------------------}
  244.  
  245. Function YepSubstOut(var f: text; s : pchar; cr : boolean) : boolean; forward;
  246.  
  247. Function SplitTheDamnQuotes(s: pchar; var ns1,ns2 : pchar) : boolean;
  248. var
  249.    ps : pchar;
  250.    sc : pchar;
  251. begin
  252.      ErrorID := 'split quotes';
  253.      ns2:=nil; sc:=nil;
  254.      SplitTheDamnQuotes:=false;
  255.      ps:=StrNew(Strquoted(s,'"','"'));
  256.      if ps<>nil then sc:=StrPos(ps,'"::"');
  257.      if sc<>nil then begin
  258.         sc^:=#0;
  259.         ns1:=StrNew(ps);
  260.         ns2:=StrNew(sc+4);
  261.         StrDispose(ps);
  262.         ps:=Nil;
  263.         SplitTheDamnQuotes:=true;
  264.      end else ns1:=ps;
  265. end;
  266.  
  267. Procedure WriteDot(c : integer);
  268. var x : byte;
  269. begin
  270.      if showdots then begin
  271.         if (c>=0) then TextColor(c);
  272.         write('.');
  273.         if (c>=0) then textcolor(lightgray);
  274.      end;
  275. end;
  276.  
  277. procedure StrDJoinC(var original : pchar; add : pchar; joint : char);
  278. var
  279.    pc : pchar;
  280.    tc : pchar;
  281. begin
  282.      ErrorID := 'StrDJoinC';
  283.      getmem(pc,strLen(original)+strLen(add)+2);
  284.      tc := strECopy(pc,original);
  285.      tc^ := joint;
  286.      inc(tc);
  287.      StrCopy(tc,add);
  288.      strDispose(original);
  289.      Original:=nil;
  290.      original := pc;
  291. end;
  292.  
  293. Function IsAHeaderLine(s : pchar) : boolean;
  294. var
  295.    cp : pointer;
  296.    sp : pointer;
  297. begin
  298.      IsAHeaderLine:=False;
  299.      if s=nil then exit;
  300.      cp := StrScan(s,':');
  301.      if (cp<>nil)and(cp<>s) then begin
  302.         sp := StrScan(s,' ');
  303.         if (longint(sp)>Longint(cp))or(sp=nil) then IsAHeaderLine:=True;
  304.      end;
  305. end;
  306.  
  307.  
  308. {-----8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-8-----}
  309. Function ReadCfg : boolean;
  310. var
  311.    someblock : byte; {1=header 2=subst}
  312.    f : text;
  313.    c : byte;
  314.    ch: char;
  315.    s : PCHAR;
  316.    ptmp : pchar;
  317.    stmp : string[4];
  318.    i : longint;
  319. begin
  320.      ErrorID := 'read cfg';
  321.      fnCfg:=GetEnv('HOME')+'\yarn\'+forceExt(fnOnly(paramstr(0)),'cfg');
  322.      if not NameExist(fnCfg) then fnCfg:=forceExt(Paramstr(0),'cfg');
  323.      ReadCfg:=False;  SomeBlock:=0; UrlCap:=nil;
  324.      filemode:=fmReadOnly+fmDenyWrite;
  325.      assign(f,fnCfg); SetTextBuf(f,fbuf, sizeof(fbuf));{$I-}Reset(f);{$I+}
  326.      if ioresult=0 then begin
  327.         while not Eof(f) do begin
  328.               readln(f,st);
  329.               S:=Ltrim(@st,' ');
  330.               if (s^<>CmtChar)and(StrLen(s)>0) then begin
  331.                  {if s[1]=' ' then s:=LTrim(s,' ');}
  332.                     if someBlock=0 then begin
  333.                        if StrIPos(s,BlockTag[1][1])=s then SomeBlock:=1
  334.                        else if StrIPos(s,BlockTag[2][1])=s then SomeBlock:=2
  335.                        else if StrIPos(s,BlockTag[3][1])=s then SomeBlock:=3
  336.                        else if StrIPos(s,BlockTag[4][1])=s then SomeBlock:=4
  337.                        else if StrIPos(s,BlockTag[5][1])=s then SomeBlock:=5
  338.                        else if StrIPos(s,cfgTag[1])=s then begin
  339.                             ptmp:=StrQuoted(s,'"','"');
  340.                             if ptmp<>nil then EdCmdLn:=StrPas(ptmp);
  341.                             StrDispose(ptmp);
  342.                             if pos('$L',EdCmdLn)>2 then StartLineMode:=1
  343.                             else if pos('$l',EdCmdLn)>2 then StartLineMode:=2;
  344.                        end
  345.                        else if StrIPos(s,cfgTag[2])=s then begin
  346.                                ptmp:=Strquoted(s,'"','"');
  347.                                CleanHeader:=upcase(ptmp^)='Y';
  348.                                StrDispose(ptmp);
  349.                             end
  350.                        else if StrIPos(s,cfgTag[4])=s then begin
  351.                                PgpPassword:=Strquoted(s,'"','"');
  352.                                ptmp:=PgpPassword;
  353.                                i:=0;
  354.                                while Ptmp^<>#0 do begin
  355.                                      if (ptmp^<'0')or(ptmp^>'9') then i := 1;
  356.                                      inc(ptmp);
  357.                                end;
  358.                                if (i=0)and((StrLen(PgpPassword) mod 3)=0) then begin
  359.                                   GetMem(ptmp,Length(Pdec(PgpPassword))+1);
  360.                                   StrPCopy(Ptmp,Pdec(PgpPassword));
  361.                                   StrDispose(PgpPassword);
  362.                                   PgpPassword:=ptmp;
  363.                                end;
  364.                             end
  365.                        else if StrIPos(s,cfgTag[8])=s then begin
  366.                                EmacsHeaderLine:=Strquoted(s,'"','"');
  367.                             end
  368.                        else if StrIPos(s,cfgTag[9])=s then begin
  369.                                ptmp:=Strquoted(s,'"','"');
  370.                                PostPrem:=upcase(ptmp^)='Y';
  371.                                StrDispose(ptmp);
  372.                             end
  373.                        else if StrIPos(s,cfgTag[6])=s then begin
  374.                                ptmp:=Strquoted(s,'"','"');
  375.                                val(ptmp,CursorAdjust,i);
  376.                                if i<>0 then begin
  377.                                   CursorAdjust:=0;
  378.                                   write('bad CursorAdjust: ',ptmp);
  379.                                end;
  380.                                StrDispose(ptmp);
  381.                             end
  382.                        else if StrIPos(s,cfgTag[11])=s then begin
  383.                                ptmp:=Strquoted(s,'"','"');
  384.                                val(ptmp,RightMargin,i);
  385.                                if i<>0 then begin
  386.                                   RightMargin:=76;
  387.                                   write('bad RightMargin: ',ptmp);
  388.                                end;
  389.                                StrDispose(ptmp);
  390.                             end
  391.                        else if StrIPos(s,cfgTag[10])=s then begin
  392.                                ptmp:=Strquoted(s,'"','"');
  393.                                if ptmp<>nil then QuoteChar:=ptmp^;
  394.                                StrDispose(ptmp);
  395.                             end
  396.                        else if StrIPos(s,cfgTag[12])=s then begin
  397.                                ptmp:=Strquoted(s,'"','"');
  398.                                if ptmp<>nil then processfiles := atrim(strpas(ptmp),'\');
  399.                                while (pos('\\',processfiles)>0) do system.delete(processfiles,pos('\\',processfiles),1);
  400.                                strdispose(ptmp);
  401.                             end
  402.                        else if StrIPos(s,cfgTag[5])=s then begin
  403.                                ptmp:=Strquoted(s,'"','"');
  404.                                ShowDots:=upcase(ptmp^)<>'N';
  405.                                StrDispose(ptmp);
  406.                             end
  407.                        else if StrIPos(s,cfgTag[7])=s then begin
  408.                                ptmp:=Strquoted(s,'"','"');
  409.                                if ptmp<>nil then fnUrlLog:=StrPas(ptmp);
  410.                                StrDispose(ptmp);
  411.                             end;
  412.                     end else if someblock=1 then begin
  413.                         if StrIPos(s,BlockTag[1][2])=s then SomeBlock:=0
  414.                         else if HeadNum<maxHead then begin
  415.                            if s^<>#0 then s:=@st;
  416.                            inc(HeadNum);
  417.                            HeadAdd[HeadNum]:=StrNew(s);
  418.                         end;
  419.                     end else if someblock=2 then begin
  420.                         if StrIPos(s,BlockTag[2][2])=s then SomeBlock:=0
  421.                         else if SubNum<maxSubst then begin
  422.                               inc(SubNum);
  423.                               SplitTheDamnQuotes(s,YepTarg[SubNum],Yepsub[SubNum]);
  424.                         end;
  425.                     end else if someblock=3 then begin
  426.                         if StrIPos(s,BlockTag[3][2])=s then SomeBlock:=0
  427.                         else if XurlNum<maxXUrl then begin
  428.                            inc(XUrlNum);
  429.                            XUrlList[XurlNum]:=StrNew(s);
  430.                         end;
  431.                     end else if someblock=4 then begin
  432.                         if StrIPos(s,BlockTag[4][2])=s then SomeBlock:=0
  433.                         else if PremNum<maxPrem then begin
  434.                            inc(PremNum);
  435.                            Prem[PremNum]:=StrNew(s);
  436.                         end;
  437.                     end else if someblock=5 then begin
  438.                         if StrIPos(s,BlockTag[5][2])=s then SomeBlock:=0
  439.                         else if BlockNum<maxBlocks then begin
  440.                               inc(BlockNum);
  441.                               SplitTheDamnQuotes(s,BlkTag[BlockNum],BlkCmd[blocknum]);
  442.                               ptmp:=StrENd(BlkTag[BlockNum])-1;
  443.                               blkClose[BlockNum]:=ptmp^;
  444.                               ptmp^:=#0;
  445.                         end;
  446.                     end;
  447.               end;
  448.         end;
  449.         close(f);
  450.         ReadCfg:=True;
  451.      end else begin
  452.          Writeln('YEP Error: can not open cfg file (',fnCfg,')');
  453.          delay(2000);
  454.      end;
  455. end;
  456. {-------------------------------------------------------------------}
  457.  
  458. Procedure ImportLine(var fout : text; fn : pchar; lineNum : longint; start, count, widthout: longint;  align : byte);
  459. { linenum=linenumber, start=first column, count=max number of characters
  460.   widthout=max width to output, align=(0=left,1=right,2=center) }
  461. var LN  : longint;
  462.     st : array[0..4096] of char;
  463.     stmp : pchar;
  464.     faux : text;
  465. begin
  466.      ErrorID := 'ImpL';
  467.      stmp:=@st; st[0]:=#0;
  468.      fileMode:=fmReadOnly+fmDenyWrite;
  469.      Assign(faux,strPas(fn)); {$I-}Reset(faux); {$I+}
  470.      if IoResult=0 then begin
  471.         ln:=0;
  472.         while (not eof(faux))and(ln<LineNum) do begin
  473.               {$I-}Readln(faux,st);{$I+}
  474.               if IoResult<>0 then begin
  475.                  textColor(blue);
  476.                  writeln;write('Error reading from "',fn,'". ',y_pac);
  477.                  readkey;
  478.               end;
  479.               inc(ln);
  480.         end;
  481.         if not((eof(faux))and(ln<>LineNum)) then begin
  482.            TextColor(green);
  483.            while (Start>0)and(stmp^<>#0) do begin inc(stmp); dec(start); end;
  484.            if count>0 then begin
  485.               if Count<StrLen(stmp) then (stmp+count)^:=#0;
  486.            end;
  487.            YepSubstOut(fout,stmp,false);
  488.         end else begin
  489.             TextColor(blue);
  490.             writeln; write('only ', ln,' lines in "',fn,'", can''t get line ',linenum,'. ',y_pac);
  491.             readkey;
  492.             end;
  493.         close(faux);
  494.      end
  495.      else begin
  496.           TextColor(blue);
  497.           writeln; write('can''t read "',fn,'". ',y_pac);
  498.           readkey;
  499.      end;
  500.      writeDot(-1);
  501. end;
  502.  
  503. Procedure InsertRndLine(var fout: text; fn : pchar);
  504. var LN  : longint;
  505.     faux : text;
  506.     padding : boolean;
  507. begin
  508.      padding:=false;
  509.      ErrorID := 'ImpR';
  510.      randomize;
  511.      ln:=CountTextLines(faux,strPas(fn),';',nil,0);
  512.      if Ln>0 then begin
  513.         ImportLine(fout, fn,random(ln)+1,0,0,0,0);
  514.      end
  515.      else begin
  516.           TextColor(blue);
  517.           writeln; write('no lines/file "',fn,'". ',y_pac);
  518.           readkey;
  519.      end;
  520. end;
  521.  
  522. Procedure ImportLR(var fout: text; s : pchar);
  523. var ln,strt,cnt, i : longint;
  524.     pc : pchar;
  525. begin
  526.      ln:=0; strt:=0; cnt:=0;
  527.      pc:=s;
  528.      while (pc^<>':')and(pc^<>'}')and(pc^<>#0) do inc(pc);
  529.      if (pc^=':') then begin
  530.         pc^:=#0; inc(pc);
  531.         val(s,ln,i);
  532.         if ln>0 then begin
  533.            s:=pc;
  534.            while (pc^<>':')and(pc^<>'}')and(pc^<>#0) do inc(pc);
  535.            if (pc^=':') then begin
  536.               pc^:=#0; inc(pc);
  537.               val(s,strt,i);
  538.               if strt>0 then begin
  539.                  s:=pc;
  540.                  while (pc^<>':')and(pc^<>'}')and(pc^<>#0) do inc(pc);
  541.                  if (pc^=':') then begin
  542.                     pc^:=#0; inc(pc);
  543.                     val(s,cnt,i);
  544.                  end;
  545.               end;
  546.            end;
  547.         end;
  548.      end;
  549.      if (ln>0) and (strt>0) and (cnt>0) and (pc^<>#0) then
  550.         importline(fout, pc,ln,strt,cnt,0,0)
  551.      else begin
  552.           textcolor(blue);
  553.           writeln;write('syntax error with {IMPLR:',pc,'}. ',y_pac);
  554.           readkey;
  555.      end;
  556. end;
  557.  
  558. Procedure ImportaFile(var fout : text; fn : pchar);
  559. var
  560.     st : array[0..4096] of char;
  561.     stmp : pchar;
  562.     faux : text;
  563. begin
  564.      ErrorID := 'ImpF';
  565.      stmp:=@st; st[0]:=#0;
  566.      fileMode:=fmReadOnly+fmDenyWrite;
  567.      Assign(faux,fn); {$I-}Reset(faux);{$I+}
  568.      if IoResult=0 then begin
  569.         TextColor(brown);
  570.         while not(eof(faux)) do begin
  571.               readln(faux,st);
  572.               if Eof(faux) then YepSubstOut(fout,stmp,false)
  573.               else YepSubstOut(fout,stmp,true);
  574.         end;
  575.         close(faux);
  576.      end
  577.      else begin
  578.           writeln;
  579.           TextColor(yellow);
  580.           writeln; write('can''t open "',fn,'". ',y_pac);
  581.           readkey;
  582.      end;
  583.      writeDot(-1);
  584. end;
  585.  
  586. Procedure ImportRFile(var fout : text; fl : pchar);
  587. var
  588.    w : word;
  589.    st : string[3];
  590.    fn : string;
  591.    faux: text;
  592. begin
  593.      ErrorID := 'RndF';
  594.      fn:=StrPas(fl);
  595.      {writeln('*',fn,'*');}
  596.      randomize;
  597.      w:=ioresult;
  598.      w:=0;
  599.      while (W<1000) do begin
  600.            inc(w);
  601.            str(w,st);
  602.            assign(faux,fn+'.'+st); {$I-}reset(faux);{$I+}
  603.            if IoResult>0 then break;
  604.            {$I-}close(faux);{$I+}
  605.      end;
  606.      if w>1 then begin
  607.         w:=succ(random(pred(w)));
  608.         str(w,st);
  609.         fn:=Fn+'.'+st;
  610.         ImportAFile(fout, Str2Pchar(fn));
  611.      end
  612.      else begin
  613.           writeln;
  614.           write('no "',fl,'.*" files to pick from. ',y_pac);
  615.           readkey;
  616.      end;
  617. end;
  618.  
  619. Procedure ImportSline(var fout : text; fn, SS :pchar; Col1Only : boolean);
  620. var found : boolean;
  621.     st : array[0..4096] of char;
  622.     stmp : pchar;
  623.     faux: text;
  624. begin
  625.      ErrorID := 'ImpSL';
  626.      stmp:=@st; st[0]:=#0; Found:=False;
  627.      fileMode:=fmReadOnly+fmDenyNone;
  628.      Assign(faux,strPas(fn)); {$I-}Reset(faux); {$I+}
  629.      if IoResult=0 then begin
  630.         while (not eof(faux))and(found=False) do begin
  631.               Readln(faux,st);
  632.               if Col1Only then begin
  633.                  if StrIPos(stmp,ss)=stmp then Found := TRUE;
  634.               end else begin
  635.                   if StrIPos(stmp,ss)<>nil then Found := TRUE;
  636.               end;
  637.         end;
  638.         close(faux);
  639.         if Found=True then begin
  640.            TextColor(green);
  641.            YepSubstOut(fout,stmp,false);
  642.         end else TextColor(lightblue);
  643.      end
  644.      else begin
  645.           TextColor(blue);
  646.           writeln; write('can''t read "',fn,'". . ',y_pac);
  647.           readkey;
  648.      end;
  649.      writeDot(-1);
  650. end;
  651.  
  652. Procedure WriteExpireDate(var f : text; l : longint);
  653. var
  654.    s : string[80];
  655.    y,m,d, dow : longint;
  656.    x  : longint;
  657. begin
  658.      if (l<1) then exit;
  659.      if (l>1000) then l := 1000;
  660.      GetDate(y,m,d,dow);
  661.      while l>0 do begin
  662.            dec(l);
  663.            inc(d);
  664.            inc(dow); if dow>6 then dow:=0;
  665.            if d>DaysInMonth(m,y) then begin inc(m); d:=1; end;
  666.            if m>MonthsInYear then begin inc(y); m:=1; end;
  667.     end;
  668.     Write(f, copy(dayStr[dow],1,3),', ',LeadZero(d,2),' ',
  669.              copy(MonthStr[m],1,3),' ',y);
  670.     s:=strpas(msghdr[hd_Date,2]);
  671.     if s[17]=' ' then write(f,copy(s,17,255)) else write(f,copy(s,16,255));
  672.  
  673. end;
  674.  
  675. Procedure ExecFile(s : pchar);
  676. var
  677.    cmd  : pchar;
  678.    isCmd: boolean;
  679. begin
  680.      ErrorID := 'execf';
  681.      ErrorDetail := StrPas(s);
  682.      cmd:=StrScan(s,' ');
  683.      if cmd=nil then begin
  684.         isCmd:=False;
  685.         cmd:=s+strLen(s);
  686.      end else begin
  687.          IsCmd:=True;
  688.          cmd^:=#0;
  689.      end;
  690.      if (NameExist(StrPas(s)))and((upcase((cmd-3)^)='E')
  691.                               and(upcase((cmd-2)^)='X')
  692.                               and(upcase((cmd-1)^)='E')) then begin
  693.         WriteDot(Darkgray);
  694.         if IsCmd then inc(cmd);
  695.         swapvectors;
  696.         Exec(StrPas(s),StrPas(cmd));
  697.         swapvectors;
  698.      end else begin
  699.          writedot(lightgray);
  700.          if IsCMD then cmd^:=' ';
  701.          swapvectors;
  702.          Exec(getenv('COMSPEC'),'/C '+StrPas(s));
  703.          swapvectors;
  704.      end;
  705. end;
  706. {----------------------------------------------------------------------}
  707. Function RNDN(s : pchar) : string;
  708. var
  709.    l,h:string[16];
  710.    lw,hw: word;
  711.    x : word;
  712.    i : Longint;
  713. begin
  714.      rndn:='';
  715.      s:=ltrim(s,' ');
  716.      while StrPos(s,':')<>nil do StrPos(s,':')^:='-';
  717.      l:=StrPas(s);
  718.      x:=system.pos('-',l);
  719.      if x=0 then begin
  720.         h:=l;
  721.         l:='1';
  722.      end else begin
  723.          h:=copy(l,x+1,255);
  724.          l:=copy(l,1,x-1);
  725.      end;
  726.      val(l,lw,i);
  727.      val(h,hw,i);
  728.      if hw<lw then begin
  729.         x:=hw;
  730.         hw:=lw;
  731.         lw:=x;
  732.      end;
  733.      if lw<0 then lw:=0;
  734.      if hw<0 then hw:=0;
  735.      if hw=lw then RNDN:=Long2Str(hw)
  736.      else begin
  737.           x:=random(hw-lw+1);
  738.           RNDN:=Long2Str(x+lw)
  739.      end;
  740. end;
  741. {----------------------------------------------------------------------}
  742. {----------------------------------------------------------------------}
  743. Function YepSubstOut(var f: text; s : pchar; cr : boolean) : boolean; {true if cr/lf written}
  744. var
  745.    c : char;
  746.    r : longint;
  747.    l : longint;
  748.    b : byte;
  749.    pc: pchar;
  750.    StartOfLine : pchar;
  751.    SearchString  : pchar;
  752.    OutputLine : boolean;
  753.    FoundTag : pchar;
  754.    FoundTagNum : integer;
  755.    stmp : pchar;
  756.    stmp2: string;
  757.  
  758.  
  759. Procedure FindTag(var FT : pchar; var FTN : integer; var YTg : array of Pchar; NTgs : byte);
  760. var b : byte;
  761. begin
  762.            FT:=nil; FTN:=-1; stmp:=nil;
  763.            for b:=0 to NTgs do begin
  764.                stmp:=StrIPos(s,YTg[b]);
  765.                if (stmp<>nil) then begin
  766.                   if (FT=nil) then begin
  767.                       FT:=stmp;
  768.                       FTN:=b;
  769.                   end
  770.                   else begin
  771.                        if (longint(stmp)<longint(FT)) then begin
  772.                           FT:=stmp;
  773.                           FTN:=b;
  774.                        end;
  775.                   end;
  776.                end;
  777.            end;
  778. end;
  779.  
  780. begin
  781.      ErrorID := 'sub scan';
  782.      if s=nil then exit;
  783.      startofline:=s; OutputLine:=TRUE;
  784.      for b:=1 to SubNum do begin
  785.          pc:=StrIPos(s,yeptarg[b]);
  786.          if pc<>nil then begin
  787. (*{}            writeln('');
  788. {}            writeln('before:"',s,'"');
  789. {}            writeln('before:"',yeptarg[b],'" at column ',StrIPosC(s,yeptarg[b]),' to "',yepsub[b],'"');*)
  790.               StrSubststr(s,yeptarg[b],YepSub[b],MaxStr,false);
  791. (*{}            writeln('after: "',s,'"');*)
  792.             writeDot(lightgreen);
  793.             s:=pc+strLen(yepsub[b]);
  794.             b:=0;
  795.          end;
  796.      end;
  797.  
  798.      s := StartOfLine;
  799.      ErrorID := 'sub special';
  800.      if StrScan(s,'{')<>nil then begin
  801.  
  802.         repeat {substituion type tags}
  803.               FindTag(FoundTag,FoundTagNum,RepTag,RepTags);
  804.  
  805.               if (FoundTag<>nil) then begin
  806.                  pc:=FoundTag+StrLen(YepTag[FoundTagNum]);
  807.                  stmp:=pc;
  808.                  b:=1;
  809.                  while (b>0)and(s^<>#0) do begin     {look for end of tag}
  810.                     if stmp^='{' then inc(b);
  811.                     if stmp^='}' then dec(b);
  812.                     inc(stmp);
  813.                  end;
  814.                  if (stmp^<>#0)or((b=0)and((stmp-1)^='}')) then begin    {if we didn't run to the end}
  815.                     (stmp-1)^:=#0;            (* put a #0 in place of '}' *)
  816.                  end;
  817.  
  818.                  ErrorDetail := StrPas(YepTag[FoundTagNum])+StrPas(pc)+'}';
  819.                  {$IFDEF DBUG}writeln(errorDetail);{$ENDIF}
  820.                  case FoundTagNum of
  821.                    0 : begin
  822.                             writedot(lightmagenta);
  823.                             stmp2:=RNDN(pc);
  824.                             b:=StrLen(RepTag[FoundTagNum])+StrLen(pc)+1;
  825.                             (stmp-1)^:='}';
  826.                             strDelete(s,Longint(FoundTag-s)+1,b);
  827.                             StrLInsert(s,Str2Pchar(Stmp2),Longint(FoundTag-s)+1,sizeof(st)-1);
  828.                        end;
  829.                    1 : begin  {YDec}
  830.                              Stmp2:=PDec(pc);
  831.                              b:=StrLen(RepTag[FoundTagNum])+StrLen(pc)+1;
  832.                              (stmp-1)^:='}';
  833.                              strDelete(s,Longint(FoundTag-s)+1,b);
  834.                              StrLInsert(s,Str2Pchar(Stmp2),Longint(FoundTag-s)+1,sizeof(st)-1);
  835.                         end;
  836.                    2 : begin
  837.                             stmp2:=dtString(StrPas(pc));
  838.                             b:=StrLen(RepTag[FoundTagNum])+StrLen(pc)+1;
  839.                             (stmp-1)^:='}';
  840.                             strDelete(s,Longint(FoundTag-s)+1,b);
  841.                             StrLInsert(s,Str2Pchar(Stmp2),Longint(FoundTag-s)+1,sizeof(st)-1);
  842.                         end;
  843.                    3 : begin
  844.                             writedot(magenta);
  845.                             if PC<>nil then stmp2:=(pc+random(StrLen(pc)))^ else Stmp2:=' ';
  846.                             b:=StrLen(RepTag[FoundTagNum])+StrLen(pc)+1;
  847.                             (stmp-1)^:='}';
  848.                             strDelete(s,Longint(FoundTag-s)+1,b);
  849.                             StrLInsert(s,Str2Pchar(Stmp2),Longint(FoundTag-s)+1,sizeof(st)-1);
  850.                        end;
  851.                  end;
  852.               end;
  853.         until (FoundTag=nil);
  854.  
  855.         ErrorID := 'sub tag';
  856.         repeat {regular tags}
  857.            FindTag(FoundTag,FoundTagNum,YepTag,YepTags);
  858.  
  859.            if (FoundTag<>nil) then begin
  860.               if (FoundTag<>s) then begin
  861.                  FoundTag^:=#0;
  862.                  Write(f,s);
  863.               end;                                  {test:something}
  864.               s:=FoundTag+StrLen(YepTag[FoundTagNum]);
  865.               pc:=s;
  866.               b:=1;
  867.               while (b>0)and(s^<>#0) do begin     {look for end of tag}
  868.                     if s^='{' then inc(b);
  869.                     if s^='}' then dec(b);
  870.                     inc(s);
  871.               end;
  872.               if (s^<>#0)or((b=0)and((s-1)^='}')) then begin    {if we didn't run to the end}
  873.                  (s-1)^:=#0;            (* put a #0 in place of '}' *)
  874.               end;
  875.  
  876.               ErrorDetail := StrPas(YepTag[FoundTagNum])+StrPas(pc)+'}';
  877.               {$IFDEF DBUG}writeln(errorDetail);{$ENDIF}
  878.               case FoundTagNum of
  879.                    0 : begin
  880.                             writedot(lightmagenta);
  881.                             Write(f,RNDN(pc));
  882.                        end;
  883.                    1 : InsertRndLine(f, pc);
  884.                    2 : ImportRFile(f,pc);
  885.                    3 : ImportaFile(f,pc);
  886.                    4 : ExecFile(pc);
  887.                    5 : begin  {ifflag}
  888.                             if (pc^='F')or(pc^='f')or(pc^='N')or(pc^='n')or(pc^='0') then
  889.                                OutputLine:=(GlobalFlag=FALSE)
  890.                             else OutputLine:=(GlobalFlag=TRUE);
  891.                             if OutputLine=False then s^:=#0;
  892.                             If (OutputLine=False)and(FoundTag<>StartOfLine) then OutputLine:=TRUE;
  893.                             if OutputLine=TRue then StartOfLine:=s;
  894. {                            if (pc^='T')or(pc^='t')or(pc^='y')or(pc^='Y') then
  895.                                OutputLine:=(GlobalFlag=TRUE)
  896.                             else OutputLine:=(GlobalFlag=FALSE);
  897.                             if OutputLine=False then s^:=#0;
  898.                             If (OutputLine=False)and(FoundTag<>StartOfLine) then OutputLine:=TRUE;
  899.                             if OutputLine=TRue then StartOfLine:=s;}
  900.                        end;
  901.                    6 : begin  {impL}
  902.                              SearchString:=pc;
  903.                              while (pc^<>':')and(pc^<>'}')and(pc^<>#0) do inc(pc);
  904.                              if (pc^=':') then begin
  905.                                  pc^:=#0; inc(pc);
  906.                                  val(SearchString,l,r);
  907.                                  ImportLine(f,pc,l,0,0,0,0);
  908.                              end else begin
  909.                                 textcolor(blue);
  910.                                 write('syntax error with {IMPL:',searchstring,'}. ',y_pac);
  911.                                 readkey;
  912.                              end;
  913.                        end;
  914.                    7..10,15-16,18,21..22 : begin  {ifs}
  915.                                SearchString:=nil;
  916.                                case FoundTagNum of
  917.                                     7 : SearchString:=msgHdr[hd_to,2];
  918.                                     8 : SearchString:=msgHdr[hd_subj,2];
  919.                                     9 : SearchString:=msgHdr[hd_date,2];
  920.                                     10: SearchString:=msgHdr[hd_ng,2];
  921.                                     15: SearchString:=msgHdr[hd_xg,2];
  922.                                     16: SearchString:=msgHdr[hd_cc,2];
  923.                                     18: SearchString:=msgHdr[hd_bcc,2];
  924.                                     21: SearchString:=msgHdr[hd_repto,2];
  925.                                     22: SearchString:=msgHdr[hd_Sender,2];
  926.                                end;
  927.                                OutputLine:=StrIPos(searchstring,pc)<>nil;
  928.                                if (OutputLine=true) then GLobalFlag:=true;
  929.                                if OutputLine=False then s^:=#0;
  930.                                if (OutputLine=False)and(FoundTag<>StartOfLine) then OutputLine:=TRUE;
  931.                           end;
  932.                    11: begin  {setflag}
  933.                             if (pc^='F')or(pc^='f')or(pc^='N')or(pc^='n')or(pc^='0') then GlobalFlag:=false
  934.                             else GlobalFlag:=true;
  935.                             if s^=#0 then OutputLine:=False
  936.                             else StartOfLine:=s;
  937.                        end;
  938.                    12 : begin  {impLS}
  939.                              SplitTheDamnQuotes(pc,SearchString,pc);
  940.                              if (SearchString<>nil)and(pc<>nil) then ImportSline(f,pc, SearchString, TRUE)
  941.                              else begin
  942.                                   textColor(blue);
  943.                                   writeln;writeln('Incorrect syntax in an ImpLS tag. ',y_pac);
  944.                                   readkey;
  945.                              end;
  946.                              StrDispose(SearchString); SearchString:=nil;
  947.                              StrDispose(pc); pc := nil;
  948.                        end;
  949.                    13 : begin  {impLR}
  950.                              ImportLR(f,pc);
  951.                        end;
  952.                    14 : begin  {uuen}
  953.                              textColor(brown);
  954.                              write('!');
  955.                              pc:=Ltrim(pc,' ');
  956.                              if UUinsert(strPas(pc),f)>0 then begin
  957.                                 writeln(f,'{uuen:',pc,'}');
  958.                                 writeln; write('uuencoding "',pc,'" error. ',y_pac);
  959.                                 readkey;
  960.                              end;
  961.                              OutputLine:=False;
  962.                         end;
  963. (*                   16 : begin  {YDec}
  964.                              Write(f,PDec(pc));
  965.                              writedot(lightmagenta);
  966.                         end;         *)
  967.                    17 : begin
  968.                              val(pc,l,r);
  969.                              write(f,'The Moon is ',MoonIs);
  970.                              if MoonShape<>'' then write(f,' ',MoonShape,' (',MoonReal:0:l,'% of Full).');
  971.                         end;
  972. {                   18 : begin
  973.                              write(f,dtString(StrPas(pc)));
  974.                         end;}
  975.                    19 : begin  {expr:}
  976.                                if msgHdr[hd_Date,2]<>nil then begin
  977.                                   val(pc,l,r);
  978.                                   WriteExpireDate(f, l);
  979.                                end;
  980.                         end;
  981.                    20 : begin
  982.                              write('-',pc,'-');
  983.                              for hr := fsthdr to lsthdr do begin
  984.                                  if strIPos(msghdr[hr,1],pc)=msghdr[hr,1] then begin
  985.                                     write(f,msghdr[hr,2]);
  986.                                     break;
  987.                                  end;
  988.                              end;
  989.                         end;
  990.               end;
  991.            end;
  992.         until (FoundTag=nil)or(s^=#0);
  993.      end;
  994.      write(f,s);
  995.      YepSubstOut:=TRUE;
  996.      if (cr)and(Outputline) then Writeln(f,'') else YepSubstOut:=FALSE;
  997.      ErrorDetail := '';
  998. end;
  999.  
  1000. {----------------------------------------------------------------------}
  1001. {----------------------------------------------------------------------}
  1002.  
  1003. Function BlankHeader(s : pchar) : Boolean;
  1004. var b,e: pchar;
  1005. begin
  1006.      ErrorID := 'blank header';
  1007.      BLankHeader:=FALSE;
  1008.      b:=StrScan(s,':');
  1009.      if B<>nil then begin
  1010.         repeat
  1011.               inc(b);
  1012.         until (b^=#0)or(b^<>' ');
  1013.         if b^=#0 then BlankHeader:=TRUE;
  1014.      end;
  1015. end;
  1016.  
  1017. Procedure RipUrls(s : pchar);
  1018. const
  1019.      badC = ' "<>),'#0#09;
  1020. var
  1021.    StartUrl : pchar;
  1022.    EndUrl : pchar;
  1023.    sp     : pchar;
  1024.    tc     : char;
  1025.    x,y    : byte;
  1026.    isXurl : boolean;
  1027. begin
  1028.      ErrorID := 'rip urls';
  1029.      sp:=s;
  1030.      for x:=1 to YepUrls do begin
  1031.          StartUrl:=StrIPos(sp,YepUrl[x]);
  1032.          while (StartUrl<>nil) do begin
  1033.                EndUrl:=StartUrl;
  1034.                while (pos(EndUrl^,badc)=0) do inc(EndUrl);
  1035.                if (EndUrl-1)^='.' then Dec(EndUrl);     {urls won't end in periods}
  1036.                tc:=EndUrl^; EndUrl^:=#0; y:=1;  IsXurl := false;
  1037.                while (y<=XurlNum)and(isXurl=FALSE) do begin
  1038.                    { writeln(' [ ',XurlList[y],'  -->  ',StartUrl,' ] '); }
  1039.                    if StrIPosC(StartUrl,XurlList[y])>0 then begin
  1040.                       isXurl:=True
  1041.                    end
  1042.                    else inc(y);
  1043.                end;
  1044.                if not(isXurl) then begin
  1045.                   TextColor(lightblue); write('u');
  1046.                   if UrlCap=nil then UrlCap:=StrNew(StartUrl)
  1047.                   else begin  {append url to dynaimc string}
  1048.                         StrDJoinC(UrlCap,StartUrl,#13);
  1049.                   end;
  1050.                end;
  1051.                if XurlNum<MaxXurl then begin
  1052.                   inc(XurlNum);
  1053.                   XurlList[XurlNum]:=StrNew(StartUrl);
  1054.                end;
  1055.                EndUrl^:=tc;
  1056.                sp:=StartUrl+4;
  1057.                StartUrl:=StrIPos(sp,YepUrl[x]);
  1058.          end;
  1059.       end;
  1060. end;
  1061.  
  1062. Procedure ExpellUrls;
  1063. var
  1064.     ep : pchar;
  1065.     sp: pchar;
  1066.     cp: pchar;
  1067.     Uend: pchar;
  1068.     openok : boolean;
  1069.     tc : char;
  1070.     faux:text;
  1071. begin
  1072.      ErrorID := 'expell urls';
  1073.      if (UrlCap=nil) then exit;
  1074.      filemode := fmWriteOnly + fmDenyWrite; OpenOk := TRUE;
  1075.      assign(faux,fnUrlLog); {$I-}append(faux);{$I+}
  1076.      if ioResult <> 0 then begin
  1077.         {$I-}rewrite(faux);{$I+}
  1078.         if IoResult <> 0 then OpenOk:=False;
  1079.      end;
  1080.  
  1081.      if openOk then begin
  1082.         sp := UrlCap;
  1083.         ep := sp;
  1084.         while (ep^<>#0) do begin
  1085.               ep := sp;
  1086.               while (ep^<>#13)and(ep^<>#0) do inc(ep);
  1087.               writeln(faux,'Comment: ');
  1088.               if msgHdr[hd_to,2]<>nil then writeln(faux,msgHdr[hd_to,1],' ',msgHdr[hd_to,2]);
  1089.               if msgHdr[hd_ng,2]<>nil then writeln(faux,msgHdr[hd_ng,1],' ',msgHdr[hd_ng,2]);
  1090.               if msgHdr[hd_xg,2]<>nil then writeln(faux,msgHdr[hd_ng,1],' ',msgHdr[hd_xg,2]);
  1091.               if msgHdr[hd_subj,2]<>nil then writeln(faux,msgHdr[hd_subj,1],' ',msgHdr[hd_subj,2]);
  1092.               tc := ep^; ep^:=#0;
  1093.               writeln(faux,'URL: ',sp);
  1094.               ep^:=tc;
  1095.               writeln(faux,'');
  1096.               if ep^<>#0 then sp:=ep+1;
  1097.               textcolor(green); write('u');
  1098.         end;
  1099.         close(faux);
  1100.     end else begin
  1101.         textColor(blue);
  1102.         writeln; writeln('can''t write to Url Log "',fnUrlLog,'". ',y_pac);
  1103.         textColor(lightgray);
  1104.         readkey;
  1105.     end;
  1106.     StrDispose(UrlCap); urlcap:=nil;
  1107.     ErrorDetail:='';
  1108. end;
  1109.  
  1110. Function PreEditor : boolean;
  1111. var line : byte;
  1112.     x    : byte;
  1113.     fs   : pchar;
  1114.     Needhead: boolean;
  1115.     InHeader: boolean;
  1116.     DoOut: boolean;
  1117.     PreMWritten : boolean;
  1118.     f    : text;
  1119.     fout : text;
  1120.     s    : pchar;
  1121.     len  : longint;
  1122.     c    : char;
  1123.     sp   : char;
  1124. begin
  1125.      ErrorID := 'pre editor'; PremWritten:=false;
  1126.      PreEditor:=True; NeedHead:=true; line:=1; DoOut:=True; InHeader:=TRUE;
  1127.      filemode:=fmReadOnly+fmDenyWrite;
  1128.      assign(f,fnEdit); SetTextBuf(f,fbuf, sizeof(fbuf)); {$I+}Reset(f);{$I-}
  1129.      if ioresult=0 then begin
  1130.      filemode:=fmWriteOnly+fmDenyWrite;
  1131.      assign(fout,fnTmp); {$I+}Rewrite(fout);{$I-}
  1132.      if IoResult=0 then begin
  1133.         while (not eof(f)) do begin
  1134.               s:=@st;
  1135.               ReadLn(f,st);
  1136.               len:=StrLen(s);
  1137.               if (fnUrlLog[0]<>#0)and(s^<>#0)and(StrScan(s,'/')<>nil) then RipUrls(s);
  1138.               if (StartLineMode=2)and(InHeader=False)and(startline=1)then
  1139.                  if (len=0) then StartLine:=line+CursorAdjust;
  1140. {              if (NeedHead=True)and(HeadNum>0) then begin
  1141.               end;}
  1142.               if (InHeader=True) then begin
  1143.                  if (NeedHead=TRUE) then begin { check for custom header there }
  1144.                     for x:=1 to HeadNum do begin
  1145.                         if HeadAdd[x]<>nil then begin
  1146.                            if headadd[x]^<>' ' then fs:=StrScan(headAdd[x],' ')
  1147.                               else fs:=strENd(HeadAdd[x]);
  1148.                            if fs<>nil then begin
  1149.                               if StrLComp(HeadAdd[x],s,longint(fs)-Longint(HeadAdd[x]))=0 then NeedHead:=False;
  1150.                            end;
  1151.                         end;
  1152.                      end;
  1153.                  end;
  1154.                  if (CleanHeader) then begin
  1155.                     if (BlankHeader(s)) then DoOut:=False;
  1156.                  end;
  1157.  
  1158.                  if (s^=' ')and(LastHeader<>hd_nil) then StrAppend(MsgHdr[LastHeader,2],s)
  1159.                  else
  1160.                  for hr:=fsthdr to lstHdr do begin
  1161.                      if StrIPos(s,MsgHdr[hr,1])=s then begin
  1162.                         if msgHdr[hr,2]<>nil then StrDispose(msgHdr[hr,2]);
  1163.                         msgHdr[hr,2]:=StrNew(s+strlen(msgHdr[hr,1])+1);
  1164.                         LastHeader := hr;
  1165.                         break;
  1166.                      end
  1167.                  end;
  1168.  
  1169.  
  1170. (*
  1171.                  if StrPos(s,msgHdr[hd_subj,1])=s then begin
  1172.                     if msgHdr[hd_subj,2]<>nil then StrDispose(msgHdr[hd_subj,2]);
  1173.                     msgHdr[hd_subj,2]:=StrNew(s+strlen(msgHdr[hd_subj,1])+1);
  1174.                  end else
  1175.                  if StrPos(s,msgHdr[hd_to,1])=s then begin
  1176.                     if msgHdr[hd_to,2]<>nil then StrDispose(msgHdr[hd_to,2]);
  1177.                     hd_To:=StrNew(s+strlen(msgHdr[hd_to,1])+1);
  1178.                  end else
  1179.                  if StrPos(s,str_date)=s then begin
  1180.                     if hd_Date<>nil then StrDispose(hd_Date);
  1181.                     hd_Date:=StrNew(s+strlen(str_date)+1);
  1182.                  end else
  1183.                  if StrPos(s,str_x_group)=s then begin
  1184.                     if hd_x_group<>nil then StrDispose(hd_x_group);
  1185.                     hd_x_group:=StrNew(s+strlen(str_x_group)+1);
  1186.                  end else
  1187.                  if StrPos(s,str_newsgroups)=s then begin
  1188.                     if hd_NewsGroups<>nil then StrDispose(hd_NewsGroups);
  1189.                     hd_newsgroups:=StrNew(s+strlen(str_newsgroups)+1);
  1190.                  end;
  1191.               *)
  1192.               end;
  1193.  
  1194.               if (InHeader=True)and(len=0) then begin
  1195.                  if Needhead=True then begin
  1196.                     for x:=1 to HeadNum do begin
  1197.                         if HeadAdd[x]<>nil then begin
  1198.                            strCopy(s,HeadAdd[x]);
  1199.                            if YepSubstOut(fout,s,true) then begin
  1200.                               Inc(Line);
  1201.                               writeDot(lightblue);
  1202.                            end;
  1203.                         end;
  1204.                     end;
  1205.                     s^:=#0;
  1206.                  end;
  1207.                  if StartLineMode=1 then StartLine:=succ(line)+CursorAdjust;
  1208.                  InHeader:=FALSE;
  1209.                  if EmacsHeaderLine<>nil then s:=EmacsHeaderLine;
  1210. {write('--');}
  1211.                  if PremNum>0 then begin
  1212.                     Writeln(fout,s);
  1213.                     for x:=1 to PremNum do begin
  1214.                         NeedHead:=YepSubstOut(fout,Prem[x],true);
  1215.                         if (PremWritten=False) and (NeedHead) then begin
  1216.                            PremWritten:=TRUE;
  1217.                         end;
  1218.                         if NeedHead then Inc(Startline);
  1219.                     end;
  1220.                     if (premWritten and PostPrem) then begin
  1221.                        s^:=#0;
  1222.                        inc(StartLine);
  1223.                     end else DoOUt:=False;
  1224.                  end;
  1225.               end;
  1226.               if DoOut then begin
  1227.                  if (s^=quotechar) then begin
  1228.                     inc(s);                           { 1   5   }
  1229.                     if (RightMargin>0) then begin     { 1234567 }
  1230.                           while (StrLen(S)>(RightMargin-1)) do begin
  1231.                                 fs:=s+RightMargin;
  1232.                                 while (fs<>s) and (fs^<>' ') do dec(fs);
  1233.                                 if (s<>fs) then begin
  1234.                                    fs^:=#0;
  1235.                                    writeln(fout,quotechar,s);
  1236.                                    s:=fs+1;
  1237.                                 end else break;
  1238.                           end;
  1239.                     end;
  1240.                     {if s^<>#0 then} Writeln(fout,quotechar,s);
  1241.                  end
  1242.                  else if YepSubstOut(fout,s,true) then inc(Line);
  1243.               end else begin
  1244.                   DoOut:=TRUE;
  1245.               end;
  1246.         end;
  1247.         close(fout); Close(f);
  1248.         if UrlCap<>nil then ExpellUrls;
  1249.      end
  1250.      else begin
  1251.           writeln(' Error: can not open file to write: ',FnTmp,'. ',y_pac);
  1252.           readkey;
  1253.      end;
  1254.      end else writeln(': new message?');
  1255. end;
  1256.  
  1257. Function CallEditor( fn : string) : byte;
  1258. var s : string[6];
  1259. begin
  1260.      ErrorID := 'call editor';
  1261.      str(StartLine,s);
  1262.      EdCmdLn:=Subststr(EdCmdLn,'$L',s,false);
  1263.      EdCmdLn:=Subststr(EdCmdLn,'$F',fn,false);
  1264.      {$IFDEF DEBUG}writeln('<',EdCmdLn,'>');{$ENDIF}
  1265.      ExecFile(Str2Pchar(EdCmdLn));
  1266.      callEditor:=DosError;
  1267. end;
  1268.  
  1269. Function PostEditor(FnOut : PathStr; BlkType : byte; already: boolean; var f : text) : boolean;
  1270. var
  1271.     line: word;
  1272.     s :  pchar;
  1273.     ec:  pchar;
  1274.     arg: pchar;
  1275.     fout : text;
  1276.     {f    : text;}
  1277.     fAlt : text;
  1278.     x : byte;
  1279.     c : char;
  1280.     fnNew: string[12];
  1281.     writeout : boolean;
  1282.     es : longint;
  1283.  
  1284. begin
  1285.      ErrorID := 'post editor';
  1286.      if BlkType>0 then Errordetail := 'new block '+StrPas(BlkTag[BlkType])+BlkClose[BlkType];
  1287.      s:=@st; writeout:=true;
  1288.      PostEditor:=True; Line:=0;
  1289.      if ALready=False then begin
  1290.         filemode:=fmReadOnly+fmDenyWrite;
  1291.         assign(f,fnTmp); {$I-}Reset(f);{$I+}
  1292.      end;
  1293.      if ioresult=0 then begin
  1294.      filemode:=fmWriteOnly+fmDenyWrite;
  1295.      assign(fout,fnOut); {$I-}Rewrite(fout);{$I+}
  1296.      if IoResult=0 then begin
  1297.         while (not eof(f)) do begin
  1298.               s:=@st; s^:=#0;
  1299.               inc(line);
  1300.               ReadLn(f,st);
  1301.  
  1302.               {emacs header}
  1303.               if (EmacsHeaderLine<>nil)and(s^=EmacsHeaderLine^) then
  1304.                  if StrComp(s,EmacsHeaderLine)=0 then begin
  1305.                     s^:=#0;
  1306.                     EmacsHeaderLine^:=#255
  1307.                  end;
  1308.  
  1309.               for x := 1 to BlockNum do begin
  1310.                   if StrIPos(s,BlkTag[x])=s then begin {is block mark}
  1311. {write(BlkTag[x],'=',line);}
  1312.                      arg:=s+(StrLen(blktag[x]));
  1313. {writeln(arg^);}
  1314.                      if (arg^=' ') then begin  {is followed by space get args}
  1315.                         inc(arg);
  1316.                         ec:=arg;
  1317.                         while (ec^<>blkClose[x])and(ec^<>#0) do inc(ec);
  1318.                         if ec^=#0 then continue; {no close so forget it}
  1319.                         ec^:=#0;
  1320.                         Arg:=StrNew(Arg);
  1321.                         ec^:=blkClose[x];
  1322.                      end else
  1323.                      if arg^=BlkClose[x] then arg:=nil else continue;
  1324.  
  1325.                      {Continue output to new file}
  1326.                      ErrorDetail := 'Outputting Block';
  1327.                      fnNew := RndFilename('ywk', 20);
  1328.                      repeat fnOut := RndFilename('ywk', 20) until fnOut<>fnNew;
  1329.  
  1330.                      writeout:=PostEditor(fnNew,x,true,f);   {loop}
  1331.  
  1332.                      {execute block process}
  1333.                      EdCmdLn:=StrPas(BlkCMD[x]);
  1334.                      if StrIpos(blkCmd[x],'*i')<>nil then EdCmdLn:=Subststr(EdCmdLn,'*I',fnNew,false);
  1335.                      if StrIpos(blkCmd[x],'*o')<>nil then EdCmdLn:=Subststr(EdCmdLn,'*O',fnOut,false);
  1336.                      if StrIpos(blkCmd[x],'*p')<>nil then EdCmdLn:=Subststr(EdCmdLn,'*P',StrPas(arg),false);
  1337.                      StrDispose(arg);
  1338. {$IFDEF DEBUG}writeln('EXECUTING: ',EdCmdLn);{$ENDIF}
  1339.                      if PgpPassword<>nil then begin
  1340.                         ec:=Environment;
  1341.                         es:=EnvSize;
  1342.                         GetMem(Environment,ES+StrLen(PgpPassStr)+StrLen(PgpPassword)+1);
  1343.                         StrCopy(Environment,PgpPassStr);
  1344.                         StrCat(Environment,PgpPassWord);
  1345.                         arg:=StrEnd(Environment);
  1346.                         inc(arg);
  1347.                         StrMove(arg,ec,ES);
  1348.                      end;
  1349. {                     writeln('Pas: ',PgpPassword);
  1350.                      writeln('ENV: ',getEnv('PGPPASS'));}
  1351. {-exec-------------} ExecFile(Str2Pchar(EdCmdLn));
  1352.                      if PgpPassword<>nil then begin
  1353.                         FreeMem(Environment,ES+StrLen(PgpPassStr)+StrLen(PgpPassword)+1);
  1354.                         Environment:=ec;
  1355.                      end;
  1356.                      if ((DosError=0)and(DosExitCode=0)) then begin
  1357.                         assign(fAlt, FnOut);
  1358.                         writeln('importing... ',fnOut);
  1359.                      end
  1360.                      else begin
  1361.                           assign(fAlt, FnNew);
  1362.                           Writeln('**ERROR** processing block: re-importing unprocessed '+fnNew);
  1363.                      end;
  1364.  
  1365.                      {append back to old file}
  1366.                      ErrorDetail := 'Reading Processed Block ';
  1367.                      filemode := fmReadWrite+fmDenyNone;
  1368.                      {$I-}reset(fAlt);{$I+}
  1369.                      if IoResult=0 then begin
  1370.                         if not eof(falt) then readln(falt,st);
  1371.                         while not eof(fAlt) do begin
  1372.                               writeln(fout,st);
  1373.                               readln(falt,st);
  1374.                         end;
  1375.                         close(Falt);
  1376.                         assign(fAlt, FnOut);
  1377.                         {$I-}Erase(Falt);{$I+}
  1378.                         es := ioresult;
  1379.                         assign(fAlt, FnNew);
  1380.                         {$I-}Erase(Falt);{$I+}
  1381.                         es := ioresult;
  1382.                      end else begin
  1383.                          StrCopy(s,'**ERROR** importing processed file');
  1384.                          writeln('**ERROR** importing processed file');
  1385.                      end;
  1386.                      s:=@st;
  1387.                      Break;
  1388.                   end;
  1389.               end;
  1390.  
  1391.               {look for close}
  1392.               if (BlkType>0)
  1393.                  and(s^<>#0)
  1394.                  and(s^=blkTag[BlkType]^) then begin
  1395.                  blockEnd^:= blkTag[BlkType]^;
  1396.                  (strEnd(BlockEnd)-1)^:= blkClose[BlkType];
  1397.                  for x := 1 to BlockNum do begin
  1398.                      if StrIPos(s,BlockEnd)=s then begin
  1399.                         close(fout);
  1400.                         exit;
  1401.                      end;
  1402.                  end;
  1403.               end;
  1404.  
  1405.               c := #0;
  1406.               repeat
  1407.                     if msgHdr[hd_ng,2]<>nil then begin
  1408.                        if (c<>#0)or(isAheaderLine(s)) then begin
  1409.                           if c<>#0 then begin
  1410.                              arg^:=c;
  1411.                              s:=arg-1;
  1412.                              s^:=' ';
  1413.                              c:=#0;
  1414.                           end;
  1415.                           if StrLen(s)>NNTP_STRLEN then begin
  1416.                              arg:=s+NNTP_STRLEN;
  1417.                              while (arg^<>'<')and(arg^<>',')and(arg<>s) do dec(arg);
  1418.                              if (arg<>s) then begin
  1419.                                 c:=arg^;
  1420.                                 arg^:=#0;
  1421.                              end else c:=#0;
  1422.                           end else c:=#0;
  1423.                        end;
  1424.                     end;
  1425.                     if (s^=quotechar) then writeln(fout,s)                          {if quote don't interpret}
  1426.                     else YepSubstOut(fout,s,true);
  1427.               until c=#0;
  1428.  
  1429.         end;
  1430.         if blkType>0 then begin
  1431.            close(fout);
  1432.            exit;
  1433.         end;
  1434.         close(fout); Close(f);
  1435.      end
  1436.      else begin
  1437.           writeln('Yep Error: can not open file to write: ',FnOut,'. ',y_pac);
  1438.           readkey;
  1439.      end;
  1440.      end
  1441.      else writeln('*block read error*',FnTmp);
  1442.      ErrorDetail := '';
  1443. end;
  1444.  
  1445. function isSnd : boolean;
  1446. var
  1447.    x : byte;
  1448.    s : string;
  1449.    c : string[15];
  1450.    m : string[15];
  1451. begin
  1452.      isSnd:=false;
  1453.      x:=1;
  1454.      while x<=length(processfiles) do begin
  1455.            m:=copy(processfiles,x,255);
  1456.            while(pos('\',m)>0) do system.delete(m,pos('\',m),sizeof(m));
  1457.            if b_or_e(fnEdit,m) then begin
  1458.               if m[length(m)]='*' then tmpnameprefix:=true;
  1459.               isSnd:=true;
  1460.               exit;
  1461.            end;
  1462.            x:=x+length(m)+1;
  1463.      end;
  1464. end;
  1465.  
  1466. function PrefixFilename(f,p : string) : string;
  1467. var
  1468.    x : byte;
  1469. begin
  1470.      PrefixFilename:='';
  1471.      x := pos('.',f);
  1472.      if (x<length(p)) then begin
  1473.         if x<>0 then PrefixFilename:=p+copy(f,x,255)
  1474.         else PrefixFilename:=p;
  1475.      end
  1476.      else begin
  1477.           for x:=1 to length(p) do f[x]:=p[x];
  1478.           PreFixFilename:=f;
  1479.      end;
  1480. end;
  1481.  
  1482. var
  1483.     x : byte;
  1484. {    isSnd : boolean;}
  1485.     FiOut : text;
  1486. BEGIN
  1487.      ProgID := 'Yarn Editor Processor [version 1.6]';
  1488.      ErrorID := 'start up';
  1489. {     assign(output,''); rewrite(output);}
  1490.      Randomize;
  1491.      TextColor(lightred);
  1492.      if ShowDots then Write('Yep');
  1493.      TextColor(red);
  1494.      {$IFDEF DEBUG}write('Debug'); checkbreak:=true;{$ENDIF}
  1495.      TextColor(lightgray);
  1496.      if (paramcount=0)or(CmdLineTog('?')) then begin
  1497.         Writeln('.... ',ProgID);
  1498.         writeln('usage: YEP <filename>.snd');
  1499.         TextColor(darkgray);
  1500.         writeln('by: Tim Middleton (as544@torfree.net)');
  1501.         halt(1);
  1502.      end;
  1503.      if not(showdots) then Writeln;
  1504.      if ReadCfg then begin
  1505.         fnEdit:=cmdLineNoTogStr(1);
  1506.         if (isSnd)and(tmpnameprefix=false) then fnTmp:=ForceExt(fnEdit,tmpext)
  1507.         else fnTmp:=PreFixFilename(fnEdit,tmpprefix);
  1508.         if isSND then PreEditor;
  1509.         if isSND then CallEditor(fnTmp) else begin
  1510.            if showdots then begin
  1511.               textcolor(darkgray);
  1512.               write('x');
  1513.            end;
  1514.            CallEditor(fnEdit);
  1515.         end;
  1516.         if isSND then Posteditor(fnEdit,0,false,fiOut);
  1517.         {$IFDEF DBUG}writeMessageData;writeConfigFileValues;{$ENDIF}
  1518.      end;
  1519.      ErrorID := 'clean up';
  1520.      for hr:=fsthdr to lsthdr do if MsgHdr[hr,2]<>nil then StrDispose(MsgHdr[hr,2]);
  1521.      if EmacsHeaderLine<>nil then StrDispose(EmacsHeaderLIne);
  1522.      if PgpPassword<>nil then StrDispose(PgpPassword);
  1523.      For x:=1 to HeadNum do StrDispose(HeadAdd[x]);
  1524.      For x:=1 to SubNum do StrDispose(YepTarg[x]);
  1525.      For x:=1 to SubNum do StrDispose(YepSub[x]);
  1526.      For x:=1 to XurlNum do StrDispose(XUrlList[x]);
  1527.      For x:=1 to PremNum do StrDispose(Prem[x]);
  1528.      For x:=1 to BlockNum do begin
  1529.          if x>blockNum then break;
  1530.          if blkTag[x]=nil then continue;
  1531.          StrEnd(BlkTag[x])^:=BlkClose[x];
  1532.          StrDispose(BlkTag[x]);
  1533.          StrDispose(BlkCmd[x]);
  1534.      end;
  1535.  
  1536.      if showdots then begin
  1537.         TextColor(lightred);
  1538.         Writeln('Yep');
  1539.         TextColor(lightgray);
  1540.      end;
  1541.         {$IFDEF DEBUG}
  1542.            delay(1000);
  1543.         {$ENDIF}
  1544.      Halt;
  1545. END.
  1546.  
  1547. {
  1548.   - YepSubst in added header line in Pre Editor.
  1549.   - CleanHeader = "Yes/NO"
  1550.   - if cfg file not found error message displayed
  1551. }
  1552.  
  1553.